home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyDES.p < prev    next >
Text File  |  1996-05-31  |  11KB  |  371 lines
  1. unit MyDES;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8. {$PUSH}
  9. {$ALIGN MAC68K}
  10.  
  11.     type
  12.         desData = record
  13.                 case boolean of
  14.                     false: (
  15.                             hi: longint;
  16.                             lo: longint;
  17.                     );
  18.                     true: (
  19.                             bytes: packed array[1..8] of Byte;
  20.                     )
  21.             end;
  22.  
  23. {$ALIGN RESET}
  24. {$POP}
  25.  
  26.     procedure StartupDES;
  27.     procedure EncryptDES (var plain, key, cipher: desData);
  28.     procedure DecryptDES (var cipher, key, plain: desData);
  29.  
  30. implementation
  31.  
  32.     uses
  33.         Resources, Errors, 
  34.         MyStartup;
  35.         
  36.     const
  37.         kInitalTr = 8;
  38.         kFinalTr = 9;
  39.         kKeyTr1 = 10;
  40.         kKeyTr2 = 11;
  41.         kFiddle = 12;
  42.  
  43.     type
  44.         posType = 0..63;
  45.         mappingType = packed array[posType] of Byte;
  46.  
  47.     var
  48.         mappings: array[0..12] of mappingType;
  49.  
  50.     procedure ReMap (var data: desData; map: integer);
  51.         var
  52.             i: integer;
  53.             t: desData;
  54.             tmp: longint;
  55.     begin
  56.         t := data;
  57.         data.lo := 0;
  58.         data.hi := 0;
  59.         i := 0;
  60.         tmp := $80000000;
  61.         while (tmp <> 0) do begin
  62.             if mappings[map, i] >= 128 then begin
  63.                 if BTST(t.hi, mappings[map, i] - 128) then begin
  64.                     data.hi := BOR(data.hi, tmp);
  65.                 end; {if}
  66.             end else begin
  67.                 if BTST(t.lo, mappings[map, i]) then begin
  68.                     data.hi := BOR(data.hi, tmp);
  69.                 end; {if}
  70.             end; {if}
  71.             tmp := BSR(tmp, 1);
  72.             i := i + 1;
  73.         end; {while}
  74.         tmp := $80000000;
  75.         while (tmp <> 0) do begin
  76.             if mappings[map, i] >= 128 then begin
  77.                 if BTST(t.hi, mappings[map, i] - 128) then begin
  78.                     data.lo := BOR(data.lo, tmp);
  79.                 end; {if}
  80.             end else begin
  81.                 if BTST(t.lo, mappings[map, i]) then begin
  82.                     data.lo := BOR(data.lo, tmp);
  83.                 end; {if}
  84.             end; {if}
  85.             tmp := BSR(tmp, 1);
  86.             i := i + 1;
  87.         end; {while}
  88.     end;
  89.  
  90.     procedure KeyRotateLeft (var key: desData);
  91.     begin
  92.         key.lo := BROTL(key.lo, 1);
  93.         if BTST(key.lo, 28) then begin
  94.             key.lo := BAND(BOR(key.lo, $00000001), $0FFFFFFF);
  95.         end else begin
  96.             key.lo := BAND(key.lo, $0FFFFFFE);
  97.         end; {if}
  98.         key.hi := BROTL(key.hi, 1);
  99.         if BTST(key.hi, 28) then begin
  100.             key.hi := BAND(BOR(key.hi, $00000001), $0FFFFFFF);
  101.         end else begin
  102.             key.hi := BAND(key.hi, $0FFFFFFE);
  103.         end; {if}
  104.     end;
  105.  
  106.     procedure KeyRotateRight (var key: desData);
  107.     begin
  108.         key.lo := BROTR(key.lo, 1);
  109.         if BTST(key.lo, 31) then begin
  110.             key.lo := BAND(BOR(key.lo, $08000000), $0FFFFFFF);
  111.         end else begin
  112.             key.lo := BAND(key.lo, $07FFFFFF);
  113.         end; {if}
  114.         key.hi := BROTR(key.hi, 1);
  115.         if BTST(key.hi, 31) then begin
  116.             key.hi := BAND(BOR(key.hi, $08000000), $0FFFFFFF);
  117.         end else begin
  118.             key.hi := BAND(key.hi, $07FFFFFF);
  119.         end; {if}
  120.     end;
  121.  
  122.     procedure Stage (var key, cipher: desData);
  123.         var
  124.             i: integer;
  125.             t: longint;
  126.             tmp: desData;
  127.     begin
  128.         tmp.lo := 0;
  129.         tmp.hi := 0;
  130.  
  131.         t := BROTL(cipher.lo, 1);
  132.         for i := 1 to 8 do begin
  133.             t := BROTL(t, 4);
  134.             tmp.bytes[i] := BAND(t, $0FF);
  135.         end;
  136.  
  137.         i := 0;
  138.         t := $80000000;
  139.         while (t <> 0) do begin
  140.             if BTST(key.hi, mappings[kKeyTr2, i]) then begin
  141.                 tmp.hi := BXOR(tmp.hi, t);
  142.             end; {if}
  143.             t := BSR(t, 1);
  144.             i := i + 1;
  145.         end; {while}
  146.         t := $80000000;
  147.         while (t <> 0) do begin
  148.             if BTST(key.lo, mappings[kKeyTr2, i]) then begin
  149.                 tmp.lo := BXOR(tmp.lo, t);
  150.             end; {if}
  151.             t := BSR(t, 1);
  152.             i := i + 1;
  153.         end; {while}
  154.  
  155.         tmp.hi := BAND(tmp.hi, $3F3F3F3F);
  156.         tmp.lo := BAND(tmp.lo, $3F3F3F3F);
  157.         t := 0;
  158.         for i := 0 to 7 do begin
  159.             t := BOR(BROTL(t, 4), mappings[i, tmp.bytes[i+1]]);
  160.         end; {for}
  161.  
  162.         tmp.lo := t;
  163.         i := 0;
  164.         t := $80000000;
  165.         while (t <> 0) do begin
  166.             if BTST(tmp.lo, mappings[kFiddle, i]) then begin
  167.                 cipher.hi := BXOR(cipher.hi, t);
  168.             end; {if}
  169.             t := BSR(t, 1);
  170.             i := i + 1;
  171.         end; {while}
  172.     end;
  173.  
  174.     procedure EncryptDES (var plain, key, cipher: desData);
  175.         var
  176.             tmpkey: desData;
  177.             t: longint;
  178.             rots: longint;
  179.     begin
  180.         tmpkey := key;
  181.         ReMap(tmpkey, kKeyTr1);
  182.         tmpkey.lo := BAND(tmpkey.lo, $0FFFFFFF);
  183.         tmpkey.hi := BAND(tmpkey.hi, $0FFFFFFF);
  184.         cipher := plain;
  185.         ReMap(cipher, kInitalTr);
  186.  
  187. {0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0}
  188.  
  189.         rots := $0000C081;
  190.         while (rots <> 0) do begin
  191.             KeyRotateLeft(tmpkey);
  192.             Stage(tmpkey, cipher);
  193.             if not BTST(rots, 0) then begin
  194.                 KeyRotateLeft(tmpkey);
  195.             end;
  196.             rots := BSR(rots, 1);
  197.             if rots <> 0 then begin
  198.                 t := cipher.lo;
  199.                 cipher.lo := cipher.hi;
  200.                 cipher.hi := t;
  201.             end; {if}
  202.         end; {while}
  203.         ReMap(cipher, kFinalTr);
  204.     end;
  205.  
  206.     procedure DecryptDES (var cipher, key, plain: desData);
  207.         var
  208.             tmpkey: desData;
  209.             t: longint;
  210.             rots: longint;
  211.     begin
  212.         tmpkey := key;
  213.         ReMap(tmpkey, kKeyTr1);
  214.         tmpkey.lo := BAND(tmpkey.lo, $0FFFFFFF);
  215.         tmpkey.hi := BAND(tmpkey.hi, $0FFFFFFF);
  216.         plain := cipher;
  217.         ReMap(plain, kInitalTr);
  218.  
  219.         t := plain.lo;
  220.         plain.lo := plain.hi;
  221.         plain.hi := t;
  222.  
  223. {0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0}
  224.  
  225.         rots := $0000C081;
  226.         while (rots <> 0) do begin
  227.             t := plain.lo;
  228.             plain.lo := plain.hi;
  229.             plain.hi := t;
  230.             Stage(tmpkey, plain);
  231.             KeyRotateRight(tmpkey);
  232.             if not BTST(rots, 0) then begin
  233.                 KeyRotateRight(tmpkey);
  234.             end;
  235.             rots := BSR(rots, 1);
  236.         end; {while}
  237.  
  238.         ReMap(plain, kFinalTr);
  239.     end;
  240.  
  241. {$IFC 0}
  242.     procedure SetupMappings;
  243.         procedure InitMapping (var o: mappingType; a00, a01, a02, a03, a04, a05, a06, a07, a08, a09, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49, a50, a51, a52, a53, a54, a55, a56, a57, a58, a59, a60, a61, a62, a63: Byte);
  244.         begin
  245.             o[0] := a00;
  246.             o[1] := a01;
  247.             o[2] := a02;
  248.             o[3] := a03;
  249.             o[4] := a04;
  250.             o[5] := a05;
  251.             o[6] := a06;
  252.             o[7] := a07;
  253.             o[8] := a08;
  254.             o[9] := a09;
  255.             o[10] := a10;
  256.             o[11] := a11;
  257.             o[12] := a12;
  258.             o[13] := a13;
  259.             o[14] := a14;
  260.             o[15] := a15;
  261.             o[16] := a16;
  262.             o[17] := a17;
  263.             o[18] := a18;
  264.             o[19] := a19;
  265.             o[20] := a20;
  266.             o[21] := a21;
  267.             o[22] := a22;
  268.             o[23] := a23;
  269.             o[24] := a24;
  270.             o[25] := a25;
  271.             o[26] := a26;
  272.             o[27] := a27;
  273.             o[28] := a28;
  274.             o[29] := a29;
  275.             o[30] := a30;
  276.             o[31] := a31;
  277.             o[32] := a32;
  278.             o[33] := a33;
  279.             o[34] := a34;
  280.             o[35] := a35;
  281.             o[36] := a36;
  282.             o[37] := a37;
  283.             o[38] := a38;
  284.             o[39] := a39;
  285.             o[40] := a40;
  286.             o[41] := a41;
  287.             o[42] := a42;
  288.             o[43] := a43;
  289.             o[44] := a44;
  290.             o[45] := a45;
  291.             o[46] := a46;
  292.             o[47] := a47;
  293.             o[48] := a48;
  294.             o[49] := a49;
  295.             o[50] := a50;
  296.             o[51] := a51;
  297.             o[52] := a52;
  298.             o[53] := a53;
  299.             o[54] := a54;
  300.             o[55] := a55;
  301.             o[56] := a56;
  302.             o[57] := a57;
  303.             o[58] := a58;
  304.             o[59] := a59;
  305.             o[60] := a60;
  306.             o[61] := a61;
  307.             o[62] := a62;
  308.             o[63] := a63;
  309.         end;
  310.  
  311.     begin
  312.         InitMapping(mappings[kInitalTr], 6, 14, 22, 30, 134, 142, 150, 158, 4, 12, 20, 28, 132, 140, 148, 156, 2, 10, 18, 26, 130, 138, 146, 154, 0, 8, 16, 24, 128, 136, 144, 152, 7, 15, 23, 31, 135, 143, 151, 159, 5, 13, 21, 29, 133, 141, 149, 157, 3, 11, 19, 27, 131, 139, 147, 155, 1, 9, 17, 25, 129, 137, 145, 153);
  313.         InitMapping(mappings[kFinalTr], 24, 152, 16, 144, 8, 136, 0, 128, 25, 153, 17, 145, 9, 137, 1, 129, 26, 154, 18, 146, 10, 138, 2, 130, 27, 155, 19, 147, 11, 139, 3, 131, 28, 156, 20, 148, 12, 140, 4, 132, 29, 157, 21, 149, 13, 141, 5, 133, 30, 158, 22, 150, 14, 142, 6, 134, 31, 159, 23, 151, 15, 143, 7, 135);
  314.         InitMapping(mappings[kKeyTr1], 0, 0, 0, 0, 7, 15, 23, 31, 135, 143, 151, 159, 6, 14, 22, 30, 134, 142, 150, 158, 5, 13, 21, 29, 133, 141, 149, 157, 4, 12, 20, 28, 0, 0, 0, 0, 1, 9, 17, 25, 129, 137, 145, 153, 2, 10, 18, 26, 130, 138, 146, 154, 3, 11, 19, 27, 131, 139, 147, 155, 132, 140, 148, 156);
  315.         InitMapping(mappings[kKeyTr2], 0, 0, 14, 11, 17, 4, 27, 23, 0, 0, 25, 0, 13, 22, 7, 18, 0, 0, 5, 9, 16, 24, 2, 20, 0, 0, 12, 21, 1, 8, 15, 26, 0, 0, 15, 4, 25, 19, 9, 1, 0, 0, 26, 16, 5, 11, 23, 8, 0, 0, 12, 7, 17, 0, 22, 3, 0, 0, 10, 14, 6, 20, 27, 24);
  316.         InitMapping(mappings[kFiddle], 16, 25, 12, 11, 3, 20, 4, 15, 31, 17, 9, 6, 27, 14, 1, 22, 30, 24, 8, 18, 0, 5, 29, 23, 13, 19, 2, 26, 10, 21, 28, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  317.  
  318.         InitMapping(mappings[7], 13, 1, 2, 15, 8, 13, 4, 8, 6, 10, 15, 3, 11, 7, 1, 4, 10, 12, 9, 5, 3, 6, 14, 11, 5, 0, 0, 14, 12, 9, 7, 2, 7, 2, 11, 1, 4, 14, 1, 7, 9, 4, 12, 10, 14, 8, 2, 13, 0, 15, 6, 12, 10, 9, 13, 0, 15, 3, 3, 5, 5, 6, 8, 11);
  319.         InitMapping(mappings[6], 4, 13, 11, 0, 2, 11, 14, 7, 15, 4, 0, 9, 8, 1, 13, 10, 3, 14, 12, 3, 9, 5, 7, 12, 5, 2, 10, 15, 6, 8, 1, 6, 1, 6, 4, 11, 11, 13, 13, 8, 12, 1, 3, 4, 7, 10, 14, 7, 10, 9, 15, 5, 6, 0, 8, 15, 0, 14, 5, 2, 9, 3, 2, 12);
  320.         InitMapping(mappings[5], 12, 10, 1, 15, 10, 4, 15, 2, 9, 7, 2, 12, 6, 9, 8, 5, 0, 6, 13, 1, 3, 13, 4, 14, 14, 0, 7, 11, 5, 3, 11, 8, 9, 4, 14, 3, 15, 2, 5, 12, 2, 9, 8, 5, 12, 15, 3, 10, 7, 11, 0, 14, 4, 1, 10, 7, 1, 6, 13, 0, 11, 8, 6, 13);
  321.         InitMapping(mappings[4], 2, 14, 12, 11, 4, 2, 1, 12, 7, 4, 10, 7, 11, 13, 6, 1, 8, 5, 5, 0, 3, 15, 15, 10, 13, 3, 0, 9, 14, 8, 9, 6, 4, 11, 2, 8, 1, 12, 11, 7, 10, 1, 13, 14, 7, 2, 8, 13, 15, 6, 9, 15, 12, 0, 5, 9, 6, 10, 3, 4, 0, 5, 14, 3);
  322.         InitMapping(mappings[3], 7, 13, 13, 8, 14, 11, 3, 5, 0, 6, 6, 15, 9, 0, 10, 3, 1, 4, 2, 7, 8, 2, 5, 12, 11, 1, 12, 10, 4, 14, 15, 9, 10, 3, 6, 15, 9, 0, 0, 6, 12, 10, 11, 1, 7, 13, 13, 8, 15, 9, 1, 4, 3, 5, 14, 11, 5, 12, 2, 7, 8, 2, 4, 14);
  323.         InitMapping(mappings[2], 10, 13, 0, 7, 9, 0, 14, 9, 6, 3, 3, 4, 15, 6, 5, 10, 1, 2, 13, 8, 12, 5, 7, 14, 11, 12, 4, 11, 2, 15, 8, 1, 13, 1, 6, 10, 4, 13, 9, 0, 8, 6, 15, 9, 3, 8, 0, 7, 11, 4, 1, 15, 2, 14, 12, 3, 5, 11, 10, 5, 14, 2, 7, 12);
  324.         InitMapping(mappings[1], 15, 3, 1, 13, 8, 4, 14, 7, 6, 15, 11, 2, 3, 8, 4, 14, 9, 12, 7, 0, 2, 1, 13, 10, 12, 6, 0, 9, 5, 11, 10, 5, 0, 13, 14, 8, 7, 10, 11, 1, 10, 3, 4, 15, 13, 4, 1, 2, 5, 11, 8, 6, 12, 7, 6, 12, 9, 0, 3, 5, 2, 14, 15, 9);
  325.         InitMapping(mappings[0], 14, 0, 4, 15, 13, 7, 1, 4, 2, 14, 15, 2, 11, 13, 8, 1, 3, 10, 10, 6, 6, 12, 12, 11, 5, 9, 9, 5, 0, 3, 7, 8, 4, 15, 1, 12, 14, 8, 8, 2, 13, 4, 6, 9, 2, 1, 11, 7, 15, 5, 12, 11, 9, 3, 7, 14, 3, 10, 10, 0, 5, 6, 0, 13);
  326.     end;
  327.  
  328.     procedure CreateResource;
  329.         var
  330.             fs: FSSpec;
  331.             resfile: integer;
  332.             hhhh: Handle;
  333.             err: OSErr;
  334.     begin
  335.         SetupMappings;
  336.         err := FSMakeFSSpec(0, 0, 'Zany:DESData', fs);
  337.         err := FSpDelete(fs);
  338.         FSpCreateResFile(fs, 'RSED', 'rsrc', 0);
  339.         resfile := FSpOpenResFile(fs, fsRdWrPerm);
  340.         if resfile <> -1 then begin
  341.             err := PtrToHand(@mappings, hhhh, SizeOf(mappings));
  342.             AddResource(hhhh, 'DESd', 128, '');
  343.             CloseResFile(resfile);
  344.         end;
  345.     end;
  346. {$ENDC}
  347.  
  348.     function InitDES(var msg: integer):OSStatus;
  349.         var
  350.             err: OSErr;
  351.             hhhh: Handle;
  352.     begin
  353. {$unused(msg)}
  354.         hhhh := GetResource('DESd', 128);
  355.         if (hhhh = nil) | (hhhh^ = nil) | (GetHandleSize(hhhh) <> SizeOf(mappings)) then begin
  356.             err := resNotFound;
  357.         end else begin
  358.             BlockMoveData(hhhh^, @mappings, SizeOf(mappings));
  359.             ReleaseResource(hhhh);
  360.             err := noErr;
  361.         end;
  362.         InitDES:=err;
  363.     end;
  364.  
  365.     procedure StartupDES;
  366.     begin
  367.         SetStartup(InitDES, nil, 0, nil);
  368.     end;
  369.     
  370. end.
  371.